perm filename M11A.F4[M11,LCS]2 blob
sn#396929 filedate 1978-11-22 generic text, type T, neo UTF8
00100 CPASS3 PASS 3 MAIN PROGRAM
00200 C *** MUSIC V ***
00300 INTEGER PEAK,CONV
00400 CXX DOUBLE PRECISION JFLNM,JTRNS,JBLA
00500 DIMENSION T(50),TI(50),ITI(50)
00600 CSS COMMON I(513) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,RPEAK,NBUF
00700 COMMON I(513) /P/P(50) /FINOUT/PEAK,RPEAK,NBUF
00800 1 /GENS/GENS(3072) /IRAN/IRAN /CONV/CONV,INIOUT,JFLNM
00900 1 /LFUNC/LFUNC
01000
01100 C NOPCD=NUM.OF OP CODES, ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
01200 DATA NOPCD/14/, ISRT/10000/, LFUNC/512/
01300 1 , NPAR/35/, NINS/27/, LBLK/512/
01400 C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., LBLK=LENGTH OF OUTPUT BLOCKS
01500
01600 COMMON /INS/INS(400),IDEF(100) /NT/RNT(1000) /ROUT/ROUT(3072)
01700 C INS=INSTRUMENT DEFINITIONS, IDEF=LOCATION TABLE, ROUT=OUTPUT BLOCK (B1→B6)(6*512)
01800 EQUIVALENCE (I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3))
01900 1, (I5,I(5)),(I6,I(6))
02000 DATA JTRNS/'TRNS '/,JBLA/' '/
02100 DATA IIIRD/976545367/
02200 C INIALIZATION OF PIECE
02300 C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
02400 CXX IRAN=32767
02500 CXX IRAN=I(7)+1
02600 IRAN=IIIRD
02700 NBUF=512
02800 INIOUT=-1
02900 C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
03000 PEAK=0
03100 CSS IPEAK=0
03200 RPEAK=0
03300 C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
03400 CC******* NREAD = 3
03500 CC******* NWRITE = 2
03600 NREAD=21
03700 C PDP DSK1=DEV.21
03800 NWRITE=1
03900 C PDP DSK=DEV.1
04000 CXX REWIND NREAD
04100 CXX REWIND NWRITE
04200 44 TYPE 401
04300 ACCEPT 501,JFLNM,CONV
04400 C TYPE <CR> FOR DEFAULT NAME(FOR21.DAT), ADD A NUM. TO WRITE SMPLS TO BE PLAYED.
04500 IF(JFLNM.EQ.JBLA)JFLNM=JTRNS
04600 CXX CALL OPEN(21,JFLNM,0,'RDO',,,'UNF')
04700 CALL IFILE(21,JFLNM)
04800 C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
04900 401 FORMAT(' TYPE FILE NAME'/)
05000 501 FORMAT(A5,5I)
05100 I2=1
05200 MS1=1
05300 MS3=MS1+(NPAR*NINS)-1
05400 MS2=NPAR
05500 I(4)=ISRT
05600 MOUT=1
05700
05800 C INITIALIZATION OF SECTION
05900 5 T(1)=0.0
06000 DO 220 N1=MS1,MS3,MS2
06100 C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
06200 220 RNT(N1)=-1
06300 DO 221 N1=1,NINS
06400 221 TI(N1)=90909.
06500
06600 C MAIN CARD READING LOOP
06700 204 CALL DATA (NREAD)
06800 IF(P(2)-T(1))200,200,244
06900 200 IOP=P(1)
07000 IF(IOP)201,201,202
07100 201 CALL ERROR(1)
07200 GO TO 204
07300
07400 202 IF(NOPCD-IOP)201,203,203
07500 203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
07600 11 IVAR=P3
07700 IVARE=IVAR+I(1)-4
07800 DO 297 N1=IVAR,IVARE
07900 IVARP=N1-IVAR+4
08000 297 I(N1)=P(IVARP)
08100 C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
08200 IF(N1.EQ.8)NBUF=512+512*I(N1)
08300 C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
08400 GO TO 204
08500 3 IGEN=P3
08600 IF(IGEN.NE.1)GO TO 282
08700 CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
08800 281 CALLGEN1
08900 GO TO 204
09000 282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
09100 CALLGEN2
09200 GO TO 204
09300
09400 4 IVAR=P3
09500 IVARE=IVAR+I(1)-4
09600 DO 296N1=IVAR,IVARE
09700 IVARP=N1-IVAR+4
09800 296 I(N1+100)=P(IVARP)
09900 GO TO 204
10000 6 CALL FROUT3(IDSK)
10100 STOP
10200
10300 C ENTER NOTE TO BE PLAYED
10400 1 DO 230N1=MS1,MS3,MS2
10500 230 IF(RNT(N1).EQ.-1)GO TO 231
10600 CALL ERROR(2)
10700 C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
10800 TYPE 1230,NINS
10900 GO TO 204
11000 1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
11100 231 M1=N1
11200 M2=N1+I(1)-1
11300 M3=M2+1
11400 M4=N1+NPAR-1
11500 DO 232N1=M1,M2
11600 M5=N1-M1+1
11700 232 RNT(N1)=P(M5)
11800 RNT(M1 )=P3
11900 DO 233N1=M3,M4
12000 233 RNT(N1)=0
12100 DO 235N1=1,NINS
12200 IF(TI(N1)-90909.)235,234,235
12300 234 TI(N1)=P(2)+P(4)
12400 ITI(N1)=M1
12500 GO TO 204
12600 235 CONTINUE
12700 CALL ERROR(3)
12800 GO TO 204
12900
13000 C DEFINE INSTRUMENT
13100 2 M1=I2
13200 M2=IFIX(P3)
13300 IDEF(M2)=M1
13400 218 CALL DATA (NREAD)
13500 IF(I(1)-2)210,210,211
13600 210 INS(M1)=0
13700 I2=M1+1
13800 GO TO 204
13900 211 INS(M1)=P3
14000 M3=I(1)
14100 INS(M1+1)=M1+M3-1
14200 M1=M1+2
14300 DO 217N1=4,M3
14400 M5=P(N1)
14500 IF(M5)212,213,213
14600 212 IF(M5+100)300,301,301
14700 300 INS(M1)=-1+(M5+101)*LFUNC
14800 GO TO 216
14900 301 INS(M1)=-1+(M5+1)*LBLK
15000 GO TO 216
15100 213 IF(M5- 100 )214,214,215
15200 214 INS(M1)=M5
15300 GO TO 216
15400 215 INS(M1)=M5+26262
15500 C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
15600 C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
15700 216 M1=M1+1
15800 217 CONTINUE
15900 GO TO 218
16000
16100 C PLAY TO ACTION TIME
16200 244 T2=P(2)
16300 250 TMIN=90909.
16400 IREST=1
16500 DO 241N1=1,NINS
16600 IF(TMIN-TI(N1))241,241,240
16700 240 TMIN=TI(N1)
16800 MNOTE=N1
16900 241 CONTINUE
17000 IF(90909.-TMIN)251,251,243
17100 243 IF(TMIN-T2)245,245,246
17200 245 T3=TMIN
17300 GO TO 260
17400 246 T3=T2
17500 GO TO 260
17600 247 IF(T(1)-T2)249,200,200
17700 249 TI(MNOTE)=90909.
17800 M2=ITI(MNOTE)
17900 RNT(M2)=-1
18000 GO TO 250
18100
18200 C SETUP REST
18300 251 T3=T2
18400 IREST=2
18500 GO TO 260
18600
18700 C PLAY
18800 260 ISAM=(T3-T(1))*FLOAT(I(4))+.5
18900 T(1)=T3
19000 IF(ISAM)247,247,266
19100 266 IF(ISAM-LBLK)262,262,263
19200 262 I5=ISAM
19300 ISAM=0
19400 GO TO 264
19500 263 I5=LBLK
19600 ISAM=ISAM-LBLK
19700 264 IF(I(8))290,290,291
19800 290 M3=MOUT+I5-1
19900 MSAMP=I5
20000 GO TO 292
20100 291 M3=MOUT+(2*I5)-1
20200 MSAMP=2*I5
20300 292 DO 267N1=MOUT,M3
20400 267 ROUT(N1)=0
20500 GO TO (268,265),IREST
20600
20700 268 DO 270 NS1=MS1,MS3,MS2
20800 IF(RNT(NS1)+1)271,270,271
20900 C GO THROUGH UNIT GENERATORS IN INSTRUMENT
21000 271 I(3)=NS1
21100 IGEN=RNT(NS1)
21200 IGEN=IDEF(IGEN)
21300 272 I6=IGEN
21400 294 CALL FORSAM
21500 295 IGEN=INS(IGEN+1)
21600 IF(INS(IGEN))270,270,272
21700 270 CONTINUE
21800 265 CALL SAMOUT(IDSK ,MSAMP)
21900 IF(ISAM)247,247,266
22000 END
22100
22200 CDATA3 PASS 3 DATA INPUTING ROUTINE
22300 SUBROUTINE DATA (N)
22400 COMMON I(1)/P/ P(1) /FINOUT/PEAK,RPEAK
22500 CSS COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK
22600 EQUIVALENCE (K,I),(P2,P(2))
22700 READ (N) K,(P(J),J=1,K)
22800 IF(P(1).EQ.1)TYPE 1,P2
22900 IF(PEAK.LE.RPEAK)RETURN
23000 CSS IF(JPEAK.LE.IPEAK)RETURN
23100 TYPE 2,PEAK
23200 CSS TYPE 2,JPEAK
23300 RPEAK=PEAK
23400 CSS IPEAK=JPEAK
23500 C TYPES OUT EACH NEW PEAK AMPL.
23600 RETURN
23700 1 FORMAT('+',F9.2,$)
23800 2 FORMAT('+ AMPL=',F5.0,$)
23900 CSS2 FORMAT('+ AMPL=',I4,$)
24000 END
24100
24200 SUBROUTINE FROUT3(IDSK)
24300 C TERMINATE OUTPUT
24400 COMMON /ROUT/ROUT(1) /FINOUT/PEAK /CONV/CONV
24500 DO 1 K=1,512
24600 1 ROUT(K)=0
24700 CALL SAMOUT(IDSK,512)
24800 TYPE 10,PEAK
24900 IF(CONV.EQ.0)CALL EXIT
25000 CALL FINFIL
25100 TYPE 2
25200 2 FORMAT(' 11.DMD WAS WRITTEN ********')
25300 CALL EXIT
25400 10 FORMAT ('0PEAK AMPLITUDE WAS ',F7.0)
25500 END